home *** CD-ROM | disk | FTP | other *** search
/ Merciful 4 / Merciful - Disc 4.iso / rexx / catalog.pprx < prev    next >
Text File  |  1996-11-02  |  21KB  |  749 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
  2.  
  3. /* $VER: Catalog.pprx 1.0 */
  4.  
  5. /** ENG
  6.  This script creates reference catalogs ("thumbnails") for the images
  7.  contained in the specified directory.
  8.  
  9.  The first requester can be used to select the catalog background
  10.  (white, gray, or black), the number of thumbnail columns (i.e. images
  11.  per row) and the temporary file directory used by the script. It is also
  12.  possible to decide whether an optimized palette should be generated for
  13.  each catalog (based on thumbnail colors) or not (the palette of the
  14.  current environment is used). The "Test Mode" option quickly shows
  15.  a sample catalog preview based on the current settings.
  16.  
  17.  The catalog format is based on the current image format (width, height,
  18.  aspect ratio and number of colors). This also affects the number of
  19.  catalog files generated.
  20.  
  21.  If not in test mode, two file requesters follow: the first one can be used
  22.  to select the source directory, the second one to select the destination
  23.  directory (where the catalog files will be saved), the root of the file
  24.  name and the file format/options. If the base name contains one or more
  25.  consecutive "0" characters, they will be used and progressively replaced
  26.  to store the ordinary catalog number (e.g. "Cat_000.pic" becomes
  27.  "Cat_001.pic", "Cat_002.pic", etc.).
  28.  
  29.  If a catalog file (matching the specified base name) already exists in
  30.  the destination directory, a message asks for confirmation before deleting
  31.  the old files.
  32.  
  33.  Several program settings affect the quality of the catalog images
  34.  generated by this script. These settings are: Color Reduction, Dithering,
  35.  Color Average Resize. For best-quality results, the
  36.  Floyd-Steinberg/Best Quality dithering should be selected, the
  37.  Color Average Resize option should be activated and an appropriate image
  38.  format should be used (the higher the number of colors, the better):
  39.  this is likely to slow down the generation of the catalog, but greatly
  40.  enhances the quality of the thumbnail catalogs.
  41. */
  42.  
  43. /** DEU
  44.  Dieses Skript ermöglicht die Erstellung eines Bilderkatalogs mit
  45.  verkleinerten Abbildungen der in einem Verzeichnis enthaltenen
  46.  Grafiken (sog. "Thumbnails").
  47.  
  48.  Im ersten Dialogfenster lassen sich Elemente wie der Seitenhintergrund
  49.  (wahlweise Weiß, Grau oder Schwarz), Spaltenanzahl (d.h.
  50.  die Anzahl der Bilder pro Zeile) und das temporäre Dateiverzeichnis für
  51.  das Skript festlegen. Es besteht darüber hinaus auch die Möglichkeit,
  52.  für jeden Katalog eine (auf der Palette der Kleingrafiken
  53.  basierende) Palette generieren zu lassen. Wird dies nicht gewünscht,
  54.  verwendet das Skript die Palette der aktuellen Arbeitsumgebung.
  55.  Mit Hilfe der Option "Testmodus" läßt sich eine
  56.  Katalogvorschau auf der Grundlage der aktuellen Einstellungen anzeigen.
  57.  
  58.  Das Format des Bilderkatalogs basiert grundsätzlich auf dem aktuellen
  59.  Bildformat (Breite, Höhe, Seitenverhältnis und Anzahl der Farben).
  60.  Auch die Anzahl der erzeugten Katalogdateien wird dadurch beeinflußt.
  61.  
  62.  Wenn Sie sich nicht im Testmodus befinden, werden noch zwei weitere
  63.  Dateiauswahlfenster geöffnet: Das erste dient zur Auswahl des Quell-,
  64.  und das zweite entsprechend zur Festlegung des Zielverzeichnisses
  65.  (dort werden die Katalogdateien gespeichert) sowie des Dateinamenstamms
  66.  und einiger Optionen bezüglich des Dateiformats. Wenn der Stamm des
  67.  Dateinamens eine oder mehrere aufeinanderfolgende Nullen "0" enthält,
  68.  werden diese zur Speicherung der Katalognummer verwendet. Beispiel:
  69.  "Katze_000.pic" wird zu "Katze_001.pic", "Katze_002.pic", usw.
  70.  
  71.  Ist im Zielverzeichnis bereits eine Katalogdatei mit dem angegebenen
  72.  Namensstamm vorhanden, so erscheint vor dem Überschreiben der alten
  73.  Dateien zunächst eine Sicherheitsabfrage.
  74.  
  75.  Die Qualität der für den Bilderkatalog erzeugten Kleingrafiken läßt sich
  76.  durch die folgenden Programmeinstellungen beeinflussen:
  77.  Farbreduzierung, Fehlerverteilung, "Farben mit Größe ändern".
  78.  Um ein optimales Ergebnis zu erzielen, sollte wie folgt vorgegangen
  79.  werden: Schalten Sie als Ditheringverfahren "Floyd-Steinberg" ein,
  80.  aktivieren Sie die Option "Farben mit Größe ändern", und verwenden Sie
  81.  ein geeignetes Bildformat, wobei gilt: Je mehr Farben, desto besser.
  82.  Dies erfordert zwar u.U. einen größeren Zeitaufwand, liefert aber eine
  83.  erheblich verbesserte Qualität der im Bilderkatalog enthaltenen Grafiken.
  84. */
  85.  
  86. IF ARG(1, EXISTS) THEN
  87.     PARSE ARG PPPORT
  88. ELSE
  89.     PPPORT = 'PPAINT'
  90.  
  91. IF ~SHOW('P', PPPORT) THEN DO
  92.     IF EXISTS('PPaint:PPaint') THEN DO
  93.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  94.         DO 30 WHILE ~SHOW('P',PPPORT)
  95.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  96.         END
  97.     END
  98.     ELSE DO
  99.         SAY "Personal Paint could not be loaded."
  100.         EXIT 10
  101.     END
  102. END
  103.  
  104. IF ~SHOW('P', PPPORT) THEN DO
  105.     SAY 'Personal Paint Rexx port could not be opened'
  106.     EXIT 10
  107. END
  108.  
  109. ADDRESS VALUE PPPORT
  110. OPTIONS RESULTS
  111. OPTIONS FAILAT 10000
  112.  
  113. Get 'LANG'
  114. IF RESULT = 1 THEN DO        /* Deutsch */
  115.     txt_test_tname    = 'Test.pic'
  116.     txt_title_set     = 'Katalogeinstellungen'
  117.     txt_title_font    = 'Font auswählen'
  118.     txt_title_src     = 'Quellverzeichnis auswählen'
  119.     txt_title_dst     = 'Format und Namensstamm auswählen'
  120.     txt_title_del     = 'Achtung'
  121.     txt_gad_bkg       = '_Hintergrund:'
  122.     txt_gad_bkg0      = 'Weiß'
  123.     txt_gad_bkg1      = 'Grau'
  124.     txt_gad_bkg2      = 'Schwarz'
  125.     txt_gad_colmn     = '_Spalten:'
  126.     txt_gad_workdir   = 'Ar_beitsverzeichnis:'
  127.     txt_gad_makeplt   = '_Palette erzeugen:'
  128.     txt_gad_test      = '_Test:'
  129.     txt_gad_yes       = '_Ja'
  130.     txt_gad_no        = '_Nein'
  131.     txt_msg_del0      = 'Sollen bestehende Alben'
  132.     txt_msg_del1      = 'gelöscht werden?'
  133.     txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  134.     txt_err_resize    = 'Fehler bei Größenberechnung: '
  135.     txt_err_load      = 'Fehler beim Laden: '
  136.     txt_err_save      = 'Fehler beim Speichern: '
  137.     txt_err_creduc    = 'Fehler bei Farbreduzierung: '
  138.     txt_err_cremap    = 'Fehler bei Farbneuberechnung: '
  139. END
  140. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  141.     txt_test_tname    = 'Prova.pic'
  142.     txt_title_set     = 'Parametri catalogo'
  143.     txt_title_font    = 'Selezionare font'
  144.     txt_title_src     = 'Selezionare cassetto immagini'
  145.     txt_title_dst     = 'Selezionare nome e formato catalogo'
  146.     txt_title_del     = 'Attenzione'
  147.     txt_gad_bkg       = '_Sfondo:'
  148.     txt_gad_bkg0      = 'Bianco'
  149.     txt_gad_bkg1      = 'Grigio'
  150.     txt_gad_bkg2      = 'Nero'
  151.     txt_gad_colmn     = 'C_olonne:'
  152.     txt_gad_workdir   = 'Cassetto di la_voro:'
  153.     txt_gad_makeplt   = 'Creare _tavolozza:'
  154.     txt_gad_test      = '_Prova:'
  155.     txt_gad_yes       = '_Sì'
  156.     txt_gad_no        = '_No'
  157.     txt_msg_del0      = 'I cataloghi esistenti'
  158.     txt_msg_del1      = 'devono essere cancellati?'
  159.     txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  160.     txt_err_resize    = 'Errore nel ridimensionamento: '
  161.     txt_err_load      = 'Errore nella lettura: '
  162.     txt_err_save      = 'Errore nella scrittura: '
  163.     txt_err_creduc    = 'Errore nella riduzione colori: '
  164.     txt_err_cremap    = 'Errore nell''adattamento colori: '
  165. END
  166. ELSE DO                /* English */
  167.     txt_test_tname    = 'Test.pic'
  168.     txt_title_set     = 'Catalog Settings'
  169.     txt_title_font    = 'Select Font'
  170.     txt_title_src     = 'Select Source Directory'
  171.     txt_title_dst     = 'Select Format and Root Name'
  172.     txt_title_del     = 'Attention'
  173.     txt_gad_bkg       = '_Background:'
  174.     txt_gad_bkg0      = 'White'
  175.     txt_gad_bkg1      = 'Gray'
  176.     txt_gad_bkg2      = 'Black'
  177.     txt_gad_colmn     = 'C_olumns:'
  178.     txt_gad_workdir   = '_Work Directory:'
  179.     txt_gad_makeplt   = '_Make Palette:'
  180.     txt_gad_test      = '_Test:'
  181.     txt_gad_yes       = '_Yes'
  182.     txt_gad_no        = '_No'
  183.     txt_msg_del0      = 'Should existing catalog files'
  184.     txt_msg_del1      = 'be deleted?'
  185.     txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
  186.     txt_err_resize    = 'Error during resize: '
  187.     txt_err_load      = 'Error during load: '
  188.     txt_err_save      = 'Error during save: '
  189.     txt_err_creduc    = 'Color reduction error: '
  190.     txt_err_cremap    = 'Color remap error: '
  191. END
  192.  
  193. Version 'REXX'
  194. IF RESULT < 7 THEN DO
  195.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  196.     EXIT 10
  197. END
  198.  
  199. srcdir      = LoadSet('SourceDir',  'PPaint:Pictures', 0)
  200. dstdir      = LoadSet('DestDir',    'PPaint:Pictures', 0)
  201. dstfile     = LoadSet('DestFile',   '000_Catalog.pic', 0)
  202. dstformat   = LoadSet('DestFormat', '', 0)
  203. fontpath    = LoadSet('FontPath',   'FONTS:', 0)
  204. fontname    = LoadSet('FontName',   'CGTriumvirate', 0)
  205. fontsize    = LoadSet('FontSize',    12, 0)
  206. fontstyle   = LoadSet('FontStyle',   's', 0)
  207. backgr      = LoadSet('Background',  0)
  208. columns     = LoadSet('Columns',     5)
  209. makepalette = LoadSet('MakePalette', 1)
  210. tempdir     = LoadSet('TempDir',     'T:')
  211. test        = LoadSet('Test',        0)
  212.  
  213. max_tempdir_size = 80
  214.  
  215. FreeEnvironment 'QUERY'
  216. IF RC ~= 0 THEN
  217.     EXIT RC
  218. FreeBrush
  219. IF RC ~= 0 THEN
  220.     EXIT RC
  221.  
  222. Request '"'txt_title_set'" ' ||,
  223.             '"CYCLE = ""'txt_gad_bkg'"", 3, 'backgr', ""'txt_gad_bkg0'"", ""'txt_gad_bkg1'"", ""'txt_gad_bkg2'"" ' ||,
  224.             ' INTSTR = ""'txt_gad_colmn'"", 1, 32767, 'columns' ' ||,
  225.             ' STRING = ""'txt_gad_workdir'"", 'max_tempdir_size', ""'tempdir'"" ' ||,
  226.             ' CHECK = ""'txt_gad_makeplt'"", 'makepalette' ' ||,
  227.             ' CHECK = ""'txt_gad_test'"", 'test' "'
  228. IF RC ~= 0 THEN
  229.     EXIT RC
  230. backgr  = RESULT.1
  231. columns = RESULT.2
  232. tempdir = RESULT.3
  233. makepalette = RESULT.4
  234. test    = RESULT.5
  235.  
  236. RequestFont '"'txt_title_font'" PATH "'fontpath'" NAME "'fontname'" SIZE "'fontsize'" STYLE "'fontstyle'"'
  237. IF RC ~= 0 THEN
  238.     EXIT RC
  239. PARSE VALUE RESULT WITH '"' fontpath '" "' fontname '"' fontsize fontstyle
  240.  
  241. IF ~test THEN DO
  242.     RequestPath '"'txt_title_src'" PATH "'srcdir'"'
  243.     IF RC ~= 0 THEN
  244.         EXIT RC
  245.     PARSE VALUE RESULT WITH '"' srcdir '"'
  246.  
  247.     RequestFile '"'txt_title_dst'" PATH "'dstdir'" FILE "'dstfile'" SAVEMODE LISTFORMATS FORCE' dstformat
  248.     IF RC ~= 0 THEN
  249.         EXIT RC
  250.     PARSE VALUE RESULT WITH '"' dstdfile '"' dstformat
  251.     ppos = MAX(LASTPOS(':', dstdfile), LASTPOS('/', dstdfile)) + 1
  252.     dstdir = LEFT(dstdfile, ppos-1)
  253.     dstfile = SUBSTR(dstdfile, ppos)
  254.  
  255.     tmpfname = 'T:pprx_cat.'PRAGMA('ID')
  256.     destpattern = dstdir || CatalogFName(dstfile, 0, 1)
  257.     ADDRESS COMMAND 'List >'tmpfname' "'destpattern'" NOHEAD PAT=~(#?.info) LFORMAT="%s%s" FILES'
  258.     oldfiles = 0
  259.     IF OPEN('listfile', tmpfname, 'R') THEN DO
  260.         IF LENGTH(READLN('listfile')) > 0 THEN
  261.             oldfiles = 1
  262.         CALL CLOSE('listfile')
  263.     END
  264.     ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  265.     IF oldfiles THEN DO
  266.         Request '"'txt_title_del'" ' ||,
  267.                     '"TEXT = ""'txt_msg_del0'"" ' ||,
  268.                     ' TEXT = ""'txt_msg_del1'"" ' ||,
  269.                     ' ACTION = ""'txt_gad_yes'"" ACTION = ""'txt_gad_no'"" ACTION = CANCEL"'
  270.         IF RC ~= 0 THEN
  271.             EXIT RC
  272.         IF RESULT = 1 THEN DO
  273.             ADDRESS COMMAND 'Delete >NIL: "'destpattern'"'
  274.             ADDRESS COMMAND 'Delete >NIL: "'destpattern'.info"'
  275.         END
  276.     END
  277. END
  278.  
  279.  
  280.  
  281. LockGUI
  282.  
  283. CALL SaveSet('SourceDir',   srcdir)
  284. CALL SaveSet('DestDir',     dstdir)
  285. CALL SaveSet('DestFile',    dstfile)
  286. CALL SaveSet('DestFormat',  dstformat)
  287. CALL SaveSet('FontPath',    fontpath)
  288. CALL SaveSet('FontName',    fontname)
  289. CALL SaveSet('FontSize',    fontsize)
  290. CALL SaveSet('FontStyle',   fontstyle)
  291. CALL SaveSet('Background',  backgr)
  292. CALL SaveSet('Columns',     columns)
  293. CALL SaveSet('MakePalette', makepalette)
  294. CALL SaveSet('TempDir',     tempdir)
  295. CALL SaveSet('Test',        test)
  296.  
  297.  
  298.  
  299. Get 'COLORS'
  300. cnum = RESULT
  301. Get 'IMAGEW'
  302. imgwidth = RESULT
  303. Get 'IMAGEH'
  304. imgheight = RESULT
  305. GetImageAttributes 'DPIX'
  306. hdpi = RESULT
  307. GetImageAttributes 'DPIY'
  308. imgratio = hdpi / RESULT
  309. Get 'CAVRESIZE'
  310. cavrg = RESULT
  311.  
  312. hgap  = TRUNC((imgwidth / columns) / 6)
  313. tilew = TRUNC((imgwidth - (hgap * (columns + 1))) / columns)
  314. hgap  = TRUNC((imgwidth - (tilew * columns)) / (columns + 1))
  315. vgap  = hgap % imgratio
  316. tileh = tilew % imgratio
  317. txgap = vgap % 10
  318.  
  319. htgap = imgwidth % 100
  320. thmbw = tilew - (htgap * 2)
  321. vtgap = htgap % imgratio
  322. thmbh = tileh - (vtgap * 2)
  323.  
  324. thmbcolors = ''
  325.  
  326. CALL FindPens
  327.  
  328. GetArea
  329. areasets = RESULT
  330. SetArea 'FILLSOLID'
  331. tmpfname = ''
  332.  
  333. Get 'GCLIP'
  334. saveclip = RESULT
  335. Set '"GCLIP=0"'
  336.  
  337. SIGNAL ON Break_C
  338.  
  339. IF test THEN DO
  340.     CALL InitPage
  341.     brushw = thmbw
  342.     brushh = (thmbh % 3) * 2
  343.     brushname = txt_test_tname
  344.     DO UNTIL AddTile(0)
  345.     END
  346.     CALL Break_C
  347.     EXIT 0
  348. END
  349.  
  350. dir_trail = RIGHT(tempdir, 1)
  351. IF dir_trail ~= ':' & dir_trail ~= '/' THEN
  352.     tempdir = tempdir || '/'
  353. tempdir = tempdir || PRAGMA('ID')
  354. ADDRESS COMMAND 'MakeDir >NIL: "'tempdir'"'
  355. IF RC ~= 0 THEN
  356.     EXIT RC
  357. tempdir = tempdir || '/'
  358.  
  359. tmpfname = 'T:pprx_cat.'PRAGMA('ID')
  360. ADDRESS COMMAND 'List >'tmpfname' "'srcdir'" NOHEAD PAT=~(#?.info) LFORMAT="%s%s" FILES'
  361. IF RC = 0 THEN DO
  362.     ADDRESS COMMAND 'Sort 'tmpfname tmpfname'.s'
  363.     IF RC = 0 THEN DO
  364.         ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  365.         tmpfname = tmpfname'.s'
  366.     END
  367. END
  368. tmpfname2 = tmpfname || '.2'
  369.  
  370. IF OPEN('listfile', tmpfname, 'R') THEN DO
  371.     errmess = ''
  372.     done = 0
  373.     catnum = 1
  374.     DO UNTIL done
  375.         CALL InitPage
  376.         DO FOREVER
  377.             fname = READLN('listfile')
  378.             IF EOF('listfile') THEN DO
  379.                 done = 1
  380.                 LEAVE
  381.             END
  382.             LoadBrush '"'fname'" QUIET FORCE NOPROGRESS'
  383.             IF RC = 0 THEN DO
  384.                 GetBrushAttributes 'WIDTH'
  385.                 bw = RESULT
  386.                 GetBrushAttributes 'HEIGHT'
  387.                 bh = RESULT
  388.                 GetBrushAttributes 'DPIX'
  389.                 bhdpi = RESULT
  390.                 GetBrushAttributes 'DPIY'
  391.                 bvdpi = RESULT
  392.                 bratio = bhdpi / bvdpi
  393.  
  394.                 brushw = thmbw;
  395.                 brushh = TRUNC(((brushw / (bw / bh)) * bratio) / imgratio)
  396.                 IF brushh > thmbh THEN DO
  397.                     brushh = thmbh;
  398.                     brushw = TRUNC(((brushh / (bh / bw)) / bratio) * imgratio)
  399.                 END
  400.  
  401.                 IF cavrg = 0 THEN
  402.                     SetBrushAttributes 'WIDTH 'brushw' HEIGHT 'brushh' NOPROGRESS'
  403.                 ELSE
  404.                     SetBrushAttributes 'WIDTH 'brushw' HEIGHT 'brushh' COLORS 256 EXTENDPALETTE NOPROGRESS'
  405.                 IF RC = 0 THEN DO
  406.                     IF makepalette THEN DO
  407.                         BrushColorStatistics 'COLORS COMPACT NOPROGRESS'
  408.                         IF RC = 0 THEN DO
  409.                             thcolors = RESULT
  410.                             IF (LENGTH(thmbcolors) + LENGTH(thcolors)) < 65535 THEN
  411.                                 thmbcolors = thmbcolors thcolors
  412.                         END
  413.                     END
  414.                     ppos = MAX(LASTPOS(':', fname), LASTPOS('/', fname)) + 1
  415.                     brushname = SUBSTR(fname, ppos)
  416.  
  417.                     SaveBrush '"'tempdir || brushname'" QUIET FORCE NOPROGRESS'
  418.                     IF RC = 0 THEN DO
  419.                         IF AddTile(0) THEN
  420.                             LEAVE
  421.                     END
  422.                     ELSE DO
  423.                         done = 1
  424.                         errmess = txt_err_resize || RC
  425.                         LEAVE
  426.                     END
  427.                 END
  428.             END
  429.             ELSE DO
  430.                 IF RC ~= 38 THEN DO    /* unrecognized format? */
  431.                     done = 1
  432.                     errmess = txt_err_load || RC
  433.                     LEAVE
  434.                 END
  435.             END
  436.         END
  437.  
  438.         IF errmess ~= '' THEN
  439.             LEAVE
  440.  
  441.         IF makepalette THEN
  442.             ReduceColors cnum '"'thmbcolors'"'
  443.         ELSE DO
  444.             done = 1
  445.             errmess = txt_err_creduc || RC
  446.             RC = 0
  447.         END
  448.         IF RC = 0 THEN DO
  449.             IF makepalette THEN DO
  450.                 SetColors 'COLORS "'RESULT'"'
  451.                 CALL FindPens
  452.             END
  453.  
  454.             tmpfname2 = tmpfname || '.2'
  455.             ADDRESS COMMAND 'List >'tmpfname2' "'tempdir'" NOHEAD PAT=~(#?.info) LFORMAT="%s%s" FILES'
  456.             IF RC = 0 THEN DO
  457.                 ADDRESS COMMAND 'Sort 'tmpfname2 tmpfname2'.s'
  458.                 IF RC = 0 THEN DO
  459.                     ADDRESS COMMAND 'Delete >NIL: 'tmpfname2
  460.                     tmpfname2 = tmpfname2'.s'
  461.                 END
  462.             END
  463.             IF OPEN('listfile2', tmpfname2, 'R') THEN DO
  464.                 CALL InitPage
  465.  
  466.                 DO FOREVER
  467.                     fname = READLN('listfile2')
  468.                     IF EOF('listfile2') THEN
  469.                         LEAVE
  470.                     LoadBrush '"'fname'" QUIET FORCE NOPROGRESS'
  471.                     IF RC = 0 THEN DO
  472.                         GetBrushAttributes 'WIDTH'
  473.                         brushw = RESULT
  474.                         GetBrushAttributes 'HEIGHT'
  475.                         brushh = RESULT
  476.  
  477.                         RemapBrush 'NOPROGRESS'
  478.                         IF RC = 0 THEN DO
  479.                             ppos = MAX(LASTPOS(':', fname), LASTPOS('/', fname)) + 1
  480.                             brushname = SUBSTR(fname, ppos)
  481.                             IF AddTile(1) THEN
  482.                                 LEAVE
  483.                         END
  484.                         ELSE DO
  485.                             done = 1
  486.                             errmess = txt_err_cremap || RC
  487.                             LEAVE
  488.                         END
  489.                     END
  490.                     ELSE DO
  491.                         done = 1
  492.                         errmess = txt_err_load || RC
  493.                         LEAVE
  494.                     END
  495.                 END
  496.                 CALL CLOSE('listfile2')
  497.  
  498.                 SaveImage '"'dstdir || CatalogFName(dstfile, catnum)'" FORCE QUIET' dstformat
  499.                 IF RC ~= 0 THEN DO
  500.                     done = 1
  501.                     errmess = txt_err_save || RC
  502.                 END
  503.                 catnum = catnum + 1
  504.             END
  505.             ADDRESS COMMAND 'Delete >NIL: 'tmpfname2
  506.         END
  507.         ADDRESS COMMAND 'Delete >NIL: "'tempdir'#?" QUIET'
  508.     END
  509.     CALL CLOSE('listfile')
  510.  
  511.     IF errmess ~= '' THEN
  512.         RequestNotify 'PROMPT "'errmess'"'
  513. END
  514.  
  515. CALL Break_C
  516.  
  517. EXIT 0
  518.  
  519.  
  520.  
  521.  
  522. InitPage:
  523.  
  524.     SetPen 'BACKGROUND 'colbackg
  525.     ClearImage
  526.  
  527.     clmn = 1
  528.     ypos = vgap
  529.     xpos = hgap
  530.  
  531.     RETURN
  532.  
  533.  
  534.  
  535.  
  536. FindPens:
  537.  
  538.     penpass = 0
  539.  
  540.     DO FOREVER
  541.         IF backgr = 0 THEN
  542.             FindColor '"255 255 255"'
  543.         ELSE IF backgr = 1 THEN
  544.             FindColor '"213 213 213"'
  545.         ELSE
  546.             FindColor '"0 0 0"'
  547.         colbackg = RESULT
  548.  
  549.         IF penpass = 0 THEN
  550.             FindColor '"213 213 213"'
  551.         ELSE
  552.             FindColor '"213 213 213" EXCLUDE "'colbackg'"'
  553.         coltile = RESULT
  554.  
  555.         IF backgr = 2 THEN
  556.             FindColor '"255 255 255"'
  557.         ELSE
  558.             FindColor '"0 0 0"'
  559.         coltext = RESULT
  560.  
  561.         FindColor '"0 0 0"'
  562.         colblack = RESULT
  563.         FindColor '"68 68 68"'
  564.         coldark1 = RESULT
  565.         FindColor '"140 140 140"'
  566.         coldark2 = RESULT
  567.         FindColor '"255 255 255"'
  568.         collight1 = colbackg
  569.         FindColor '"240 240 240"'
  570.         collight2 = RESULT
  571.  
  572.         penpass = penpass + 1
  573.         IF penpass > 1 THEN
  574.             LEAVE
  575.         IF collight1 ~= coltile & coldark1 ~= coltile THEN
  576.             LEAVE
  577.     END
  578.  
  579.     RETURN
  580.  
  581.  
  582.  
  583.  
  584. CatalogFName:
  585.     basefname = ARG(1)
  586.     catlgnum  = ARG(2)
  587.     IF ARG() > 2 THEN
  588.         pattern_fname = ARG(3)
  589.     ELSE
  590.         pattern_fname = 0
  591.  
  592.     npos1 = INDEX(basefname, '0')
  593.     IF npos1 = 0 THEN
  594.         RETURN basefname
  595.  
  596.     ndigits = 1
  597.     bfnlen = LENGTH(basefname)
  598.     DO npos = npos1 + 1 TO bfnlen
  599.         IF SUBSTR(basefname, npos, 1) = '0' THEN
  600.             ndigits = ndigits + 1
  601.         ELSE
  602.             LEAVE
  603.     END
  604.     IF pattern_fname THEN
  605.         catgfname = LEFT(basefname, npos1 - 1) || '#?' || SUBSTR(basefname, npos)
  606.     ELSE
  607.         catgfname = LEFT(basefname, npos1 - 1) || RIGHT(catlgnum, ndigits, "0") || SUBSTR(basefname, npos)
  608.  
  609.     RETURN catgfname
  610.  
  611.  
  612.  
  613. AddTile:
  614.     with_brush = ARG(1)
  615.  
  616.     SetPen 'FOREGROUND 'coltile
  617.     DrawRectangle xpos ypos xpos+tilew-1 ypos+tileh-1 'FILL'
  618.  
  619.     xp0 = xpos + htgap + ((thmbw - brushw) % 2)
  620.     yp0 = ypos + vtgap + ((thmbh - brushh) % 2)
  621.  
  622.     IF collight1 ~= coltile & coldark1 ~= coltile THEN DO
  623.         xp1 = xp0 + brushw - 1
  624.         yp1 = yp0 + brushh - 1
  625.         xps1 = xpos + tilew - 1
  626.         yps1 = ypos + tileh - 1
  627.  
  628.         SetPen 'FOREGROUND 'collight1
  629.         DrawRectangle xp0    yp1+1  xp1+1   yp1+1 'FILL'
  630.         DrawRectangle xp1+1  yp1+1  xp1+1   yp0-1 'FILL'
  631.         DrawRectangle xpos    yps1  xpos    ypos  'FILL'
  632.         DrawRectangle xpos    ypos  xps1-1  ypos  'FILL'
  633.         SetPen 'FOREGROUND 'coldark1
  634.         DrawRectangle xp0-1  yp1+1  xp0-1   yp0-1 'FILL'
  635.         DrawRectangle xp0-1  yp0-1  xp1     yp0-1 'FILL'
  636.         DrawRectangle xpos+1  yps1  xps1    yps1  'FILL'
  637.         DrawRectangle xps1    yps1  xps1    ypos  'FILL'
  638.  
  639.         IF collight1 ~= collight2 & coldark1 ~= coldark2 THEN DO
  640.             SetPen 'FOREGROUND 'collight2
  641.             DrawRectangle xp0-1    yp1+2  xp1+2   yp1+2  'FILL'
  642.             DrawRectangle xp1+2    yp1+2  xp1+2   yp0-2  'FILL'
  643.             DrawRectangle xpos+1  yps1-1  xpos+1  ypos+1 'FILL'
  644.             DrawRectangle xpos+1  ypos+1  xps1-2  ypos+1 'FILL'
  645.             SetPen 'FOREGROUND 'coldark2
  646.             DrawRectangle xp0-2    yp1+2  xp0-2   yp0-2  'FILL'
  647.             DrawRectangle xp0-2    yp0-2  xp1+1   yp0-2  'FILL'
  648.             DrawRectangle xpos+2  yps1-1  xps1-1  yps1-1 'FILL'
  649.             DrawRectangle xps1-1  yps1-1  xps1-1  ypos+1 'FILL'
  650.         END
  651.     END
  652.  
  653.     IF with_brush THEN DO
  654.         SetPaintMode 'REPLACE'
  655.         SetBrushHandle 'UPPERLEFT'
  656.         PutBrush xp0 yp0
  657.     END
  658.     ELSE DO
  659.         SetPen 'FOREGROUND 'colblack
  660.         DrawRectangle xp0 yp0 xp0+brushw-1 yp0+brushh-1 'FILL'
  661.     END
  662.  
  663.     textyp = ypos + tileh + txgap
  664.     textx0 = xpos - hgap
  665.     textx1 = xpos + tilew + hgap - 1
  666.     SetPen 'FOREGROUND 'coltext
  667.     VectorText 'TEXT "'brushname'" FONTPATH "'fontpath'" FONTNAME "'fontname'" X0 'textx0' Y0 'textyp' X1 'textx1' Y1' (textyp + fontsize - 1) 'CENTER ANTIALIAS 2 KEEPRATIO KEEPBASELINE'
  668.     IF RC ~= 0 THEN
  669.         Text 'TEXT "'brushname'" FONTPATH "'fontpath'" FONTNAME "'fontname'" FONTSIZE 'fontsize' FONTSTYLE "'fontstyle'" X' (xpos + (tilew % 2)) ' Y 'textyp' CENTER'
  670.  
  671.     last_one = 0
  672.     xpos = xpos + tilew + hgap
  673.     clmn = clmn + 1
  674.     IF clmn > columns THEN DO
  675.         clmn = 1
  676.         xpos = hgap
  677.         totvgap = tileh + txgap + fontsize + (vgap % 3)
  678.         ypos = ypos + totvgap
  679.         IF (ypos + totvgap) > imgheight THEN
  680.             last_one = 1
  681.     END
  682.  
  683.     RETURN last_one
  684.  
  685.  
  686.  
  687.  
  688. SaveSet:
  689.     sname = ARG(1)
  690.     val = ARG(2)
  691.  
  692.     IF OPEN('settingfile', 'ENV:PP_Catal_'sname, 'W') THEN DO
  693.         CALL WRITECH('settingfile', val)
  694.         CALL CLOSE('settingfile')
  695.     END
  696.  
  697.     RETURN
  698.  
  699.  
  700.  
  701.  
  702. LoadSet:
  703.     sname = ARG(1)
  704.     def_val = ARG(2)
  705.     IF ARG() > 2 THEN
  706.         request_quote = ARG(3)
  707.     ELSE
  708.         request_quote = 1
  709.  
  710.     val = def_val
  711.     set_fname = 'ENV:PP_Catal_'sname
  712.  
  713.     IF OPEN('settingfile', set_fname, 'R') THEN DO
  714.         val = READCH('settingfile', 65535)
  715.         CALL CLOSE('settingfile')
  716.     END
  717.  
  718.     IF request_quote THEN DO
  719.         /* encode quotes for the Request command ('"' -> '\""') */
  720.         qpos_start = 1
  721.         DO FOREVER
  722.             qpos = INDEX(val, '"', qpos_start)
  723.             IF qpos = 0 THEN BREAK
  724.             val = INSERT('\"', val, qpos-1)
  725.             qpos_start = qpos + 3
  726.         END
  727.     END
  728.  
  729.     RETURN val
  730.  
  731.  
  732.  
  733.  
  734.  
  735. Break_C:
  736.  
  737.     IF tmpfname ~= '' THEN DO
  738.         ADDRESS COMMAND 'Delete >NIL: "'tempdir'" ALL QUIET'
  739.         ADDRESS COMMAND 'Delete >NIL: 'tmpfname tmpfname2
  740.     END
  741.  
  742.     FreeBrush 'FORCE'
  743.     SelectSquareBrush 1
  744.     SetArea areasets
  745.     Set '"GCLIP='saveclip'"'
  746.     UnlockGUI
  747.  
  748.     RETURN 1
  749.